
{***********************************************************}
{                                                           }
{      Luxena Class Library                                 }
{                                                           }
{      Common Usage Classes                                 }
{                                                           }
{      Copyright (c) 2001-2008 Luxena Software Company      }
{      http://www.luxena.com                                }
{      e-mail: support@luxena.com                           }
{                                                           }
{***********************************************************}

unit LXClasses;

{$I lx.inc}

interface

uses Classes;

type

{ TLXUnknownStub }

  TLXUnknownStub = class(TObject, IUnknown)
  protected
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  end;


{ TLXDelegat }

  TLXDelegatEvent = procedure (Args: TObject) of object;

  TLXDelegat = class
  private
    FHandlers: TList;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Attach(Handler: TLXDelegatEvent);
    procedure Detach(Handler: TLXDelegatEvent);
    procedure Notify(Args: TObject);
  end;


{ TLXStringHash }

  PLXStringHashTable = ^PLXStringHashItem;

  PLXStringHashItem = ^TLXStringHashItem;
  TLXStringHashItem = record
    Key: string;
    Data: Pointer;
    Next: PLXStringHashItem;
  end;
  TLXStringHashItemArray = array [0..0] of PLXStringHashItem;

  TLXStringHashDeleteEvent = procedure(Data: Pointer) of object;

  TLXStringHash = class
  private
    FSize: Integer;
    FTable: PLXStringHashTable;
    FCount: Integer;
    FOnDelete: TLXStringHashDeleteEvent;
  protected
    function Evaluate(const Key: string): Integer;
  public
    constructor Create(Size: Integer);
    destructor Destroy; override;
    procedure Clear;
    function Add(const Key: string): PLXStringHashItem;
    function Put(const Key: string): PLXStringHashItem;
    function Get(const Key: string): PLXStringHashItem;
    function Remove(const Key: string; DeleteHandler: TLXStringHashDeleteEvent = nil): PLXStringHashItem;
    function Delete(const Key: string): PLXStringHashItem;
    property Size: Integer read FSize;
    property Count: Integer read FCount;
    property OnDelete: TLXStringHashDeleteEvent read FOnDelete write FOnDelete;
  end;

  TLXStringHashIterator = class
  private
    FChain: PLXStringHashTable;
    FLast: PLXStringHashTable;
    FItem: PLXStringHashItem;
    procedure SetItem(Item: PLXStringHashItem);
  public
    constructor Create(Hash: TLXStringHash);
    procedure Next;
    property Item: PLXStringHashItem read FItem;
  end;


{ TLXCaseInsensitiveStringHash }

  TLXCaseInsensitiveStringHash = class(TLXStringHash)
  public
    function Add(const Key: string): PLXStringHashItem;
    function Put(const Key: string): PLXStringHashItem;
    function Get(const Key: string): PLXStringHashItem;
    function Remove(const Key: string; DeleteHandler: TLXStringHashDeleteEvent = nil): PLXStringHashItem;
    function Delete(const Key: string): PLXStringHashItem;
  end;


{ TLXStringHashOfStrings }

  TLXStringHashOfStrings = class(TLXStringHash)
  private
    procedure DeleteStringReference(Data: Pointer);
  protected
    property OnDelete;
  public
    constructor Create(Size: Integer);
    function Add(const Key, Data: string): PLXStringHashItem; overload;
    function Put(const Key, Data: string): PLXStringHashItem; overload;
  end;


{ TLXStringHashOfObjects }

  TLXStringHashOfObjects = class(TLXStringHash)
  private
    procedure DeleteObjectReference(Data: Pointer);
  protected
    property OnDelete;
  public
    constructor Create(Size: Integer; OwnObjects: Boolean = True);
    function Add(const Key: string; Data: TObject): PLXStringHashItem; overload;
    function Put(const Key: string; Data: TObject): PLXStringHashItem; overload;
  end;


{ TLXStringHashOfUnknowns }

  TLXStringHashOfUnknowns = class(TLXStringHash)
  private
    procedure DeleteUnknownReference(Data: Pointer);
  protected
    property OnDelete;
  public
    constructor Create(Size: Integer);
    function Add(const Key: string; const Unk: IUnknown): PLXStringHashItem; overload;
    function Put(const Key: string; const Unk: IUnknown): PLXStringHashItem; overload;
  end;


{ TLXStringHashOfVariants }

  TLXStringHashOfVariants = class(TLXStringHash)
  private
    procedure DeleteVariantReference(Data: Pointer);
  protected
    property OnDelete;
  public
    constructor Create(Size: Integer);
    function Add(const Key: string; const Data: Variant): PLXStringHashItem; overload;
    function Put(const Key: string; const Data: Variant): PLXStringHashItem; overload;
  end;


implementation

uses SysUtils, LXConsts;


{ TLXUnknownStub }

function TLXUnknownStub.QueryInterface(const IID: TGUID; out Obj): HResult;
const
  E_NOINTERFACE = HResult($80004002);
begin
  if GetInterface(IID, Obj) then Result := 0 else Result := E_NOINTERFACE;
end;

function TLXUnknownStub._AddRef: Integer;
begin
  Result := -1;
end;

function TLXUnknownStub._Release: Integer;
begin
  Result := -1;
end;


{ TLXDelegat }

type
  PLXDelegatRecord = ^TLXDelegatRecord;
  TLXDelegatRecord = record
    Handler: TLXDelegatEvent;
  end;

constructor TLXDelegat.Create;
begin
  inherited;
  FHandlers := TList.Create;
end;

destructor TLXDelegat.Destroy;
var
  I: Integer;
begin
  for I := 0 to FHandlers.Count - 1 do
    Dispose(PLXDelegatRecord(FHandlers[I]));
  FHandlers.Free;
  inherited;
end;

procedure TLXDelegat.Attach(Handler: TLXDelegatEvent);
var
  DelegatRecord: PLXDelegatRecord;
begin
  New(DelegatRecord);
  DelegatRecord.Handler := Handler;
  FHandlers.Add(DelegatRecord);
end;

procedure TLXDelegat.Detach(Handler: TLXDelegatEvent);
var
  I: Integer;
  DelegatRecord: PLXDelegatRecord;
begin
  for I := 0 to FHandlers.Count - 1 do
  begin
    DelegatRecord := FHandlers[I];
    if PInt64(DelegatRecord)^ = PInt64(@@Handler)^ then
    begin
      FHandlers.Delete(I);
      Dispose(DelegatRecord);
      Break;
    end;
  end;
end;

procedure TLXDelegat.Notify(Args: TObject);
var
  I: Integer;
begin
  for I := 0 to FHandlers.Count - 1 do
    PLXDelegatRecord(FHandlers[I]).Handler(Args);
end;


{ TLXStringHash }

constructor TLXStringHash.Create(Size: Integer);
var
  Memory: Integer;
begin
  inherited Create;
  if Size < 1 then
    raise Exception.Create(SDimensionError);
  FSize := Size;
  Memory := SizeOf(TLXStringHashItem) * FSize;
  FTable := AllocMem(Memory);
end;

destructor TLXStringHash.Destroy;
begin
  Clear;
  FreeMem(FTable);
  inherited;
end;

procedure TLXStringHash.Clear;
var
  I: Integer;
  P: PLXStringHashItem;
  Chain: PLXStringHashTable;
begin
  Chain := FTable;
  for I := 0 to FSize - 1 do
  begin
    P := Chain^;
    while P <> nil do
    begin
      if Assigned(FOnDelete) then FOnDelete(P.Data);
      Chain^ := P.Next;
      Dec(FCount);
      Dispose(P);
      P := Chain^;
    end;
    Inc(Chain);
  end;
end;

function TLXStringHash.Evaluate(const Key: string): Integer; assembler;
asm
    push  ebx
    push  esi
    push  edi
    mov   esi, [eax].FSize
    cmp   edx, 0
    jz    @2
    xor   ebx, ebx
  @1:
    ror   eax, 8
    mov   bl, [edx]
    cmp   ebx, 0
    jz    @2
    add   eax, ebx
    inc   edx
    cmp   ebx, 0
    jmp   @1
  @2:
    xor   edx, edx
    div   esi
    mov   eax, edx
    pop   edi
    pop   esi
    pop   ebx
end;

function TLXStringHash.Add(const Key: string): PLXStringHashItem;
var
  Chain: PLXStringHashTable;
begin
  Chain := FTable;
  Inc(Chain, Evaluate(Key));
  New(Result);
  Result.Next := Chain^;
  Chain^ := Result;
  Inc(FCount);
  Result.Key := Key;
end;

function TLXStringHash.Put(const Key: string): PLXStringHashItem;
var
  Chain: PLXStringHashTable;
begin
  Chain := FTable;
  Inc(Chain, Evaluate(Key));
  Result := Chain^;
  while Result <> nil do
  begin
    if Result.Key = Key then
      Exit;
    Chain := @Result.Next;
    Result := Chain^;
  end;
  New(Result);
  Result.Next := nil;
  Chain^ := Result;
  Inc(FCount);
  Result.Key := Key;
  Result.Data := nil;
end;

function TLXStringHash.Get(const Key: string): PLXStringHashItem;
begin
  Result := TLXStringHashItemArray(FTable^)[Evaluate(Key)];
  while Result <> nil do
  begin
    if Result.Key = Key then Exit;
    Result := Result.Next;
  end;
  Result := nil;
end;

function TLXStringHash.Remove(const Key: string;
  DeleteHandler: TLXStringHashDeleteEvent = nil): PLXStringHashItem;
var
  Chain: PLXStringHashTable;
begin
  Chain := FTable;
  Inc(Chain, Evaluate(Key));
  Result := Chain^;
  while Result <> nil do
  begin
    if Result.Key = Key then
    begin
      if Assigned(DeleteHandler) then DeleteHandler(Result.Data);
      Chain^ := Result.Next;
      Dec(FCount);
      Dispose(Result);
      Exit;
    end;
    Chain := @Result.Next;
    Result := Chain^;
  end;
  Result := nil;
end;

function TLXStringHash.Delete(const Key: string): PLXStringHashItem;
begin
  Result := Remove(Key, FOnDelete);
end;


{ TLXStringHashIterator }

constructor TLXStringHashIterator.Create(Hash: TLXStringHash);
begin
  if Hash = nil then
    raise Exception.Create(SIteratorHashError);
  FChain := Hash.FTable;
  FLast := FChain;
  Inc(FLast, Hash.FSize - 1);
  SetItem(FChain^);
end;

procedure TLXStringHashIterator.SetItem(Item: PLXStringHashItem);
begin
  while (Item = nil) and (FChain <> FLast) do
  begin
    Inc(FChain);
    Item := FChain^;
  end;
  FItem := Item;
end;

procedure TLXStringHashIterator.Next;
begin
  if FItem <> nil then SetItem(FItem.Next);
end;


{ TLXCaseInsensitiveStringHash }

function TLXCaseInsensitiveStringHash.Add(const Key: string): PLXStringHashItem;
begin
  Result := inherited Add(LowerCase(Key));
end;

function TLXCaseInsensitiveStringHash.Put(const Key: string): PLXStringHashItem;
begin
  Result := inherited Put(LowerCase(Key));
end;

function TLXCaseInsensitiveStringHash.Get(const Key: string): PLXStringHashItem;
begin
  Result := inherited Get(LowerCase(Key));
end;

function TLXCaseInsensitiveStringHash.Remove(const Key: string;
  DeleteHandler: TLXStringHashDeleteEvent): PLXStringHashItem;
begin
  Result := inherited Remove(LowerCase(Key), DeleteHandler);
end;

function TLXCaseInsensitiveStringHash.Delete(const Key: string): PLXStringHashItem;
begin
  Result := inherited Delete(LowerCase(Key));
end;


{ TLXStringHashOfStrings }

constructor TLXStringHashOfStrings.Create(Size: Integer);
begin
  inherited Create(Size);
  OnDelete := DeleteStringReference;
end;

procedure TLXStringHashOfStrings.DeleteStringReference(Data: Pointer);
begin
  string(Data) := '';
end;

function TLXStringHashOfStrings.Add(const Key, Data: string): PLXStringHashItem;
begin
  Result := Add(Key);
  string(Result^.Data) := Data;
end;

function TLXStringHashOfStrings.Put(const Key, Data: string): PLXStringHashItem;
begin
  Result := Put(Key);
  string(Result^.Data) := Data;
end;


{ TLXStringHashOfObjects }

constructor TLXStringHashOfObjects.Create(Size: Integer; OwnObjects: Boolean);
begin
  inherited Create(Size);
  if OwnObjects then
    OnDelete := DeleteObjectReference;
end;

procedure TLXStringHashOfObjects.DeleteObjectReference(Data: Pointer);
begin
  TObject(Data).Free;
end;

function TLXStringHashOfObjects.Add(const Key: string; Data: TObject): PLXStringHashItem;
begin
  Result := Add(Key);
  Result.Data := Data;
end;

function TLXStringHashOfObjects.Put(const Key: string; Data: TObject): PLXStringHashItem;
begin
  Result := Put(Key);
  Result.Data := Data;
end;


{ TLXStringHashOfUnknowns }

constructor TLXStringHashOfUnknowns.Create(Size: Integer);
begin
  inherited Create(Size);
  OnDelete := DeleteUnknownReference;
end;

procedure TLXStringHashOfUnknowns.DeleteUnknownReference(Data: Pointer);
begin
  if Data <> nil then
    IUnknown(Data)._Release;
end;

function TLXStringHashOfUnknowns.Add(const Key: string; const Unk: IUnknown):
  PLXStringHashItem;
begin
  Result := Add(Key);
  Result.Data := Pointer(Unk);
  if Unk <> nil then
    Unk._AddRef;
end;

function TLXStringHashOfUnknowns.Put(const Key: string; const Unk: IUnknown):
  PLXStringHashItem;
begin
  Result := Put(Key);
  Result.Data := Pointer(Unk);
  if Unk <> nil then
    Unk._AddRef;
end;


{ TLXStringHashOfVariants }

constructor TLXStringHashOfVariants.Create(Size: Integer);
begin
  inherited Create(Size);
  OnDelete := DeleteVariantReference;
end;

procedure TLXStringHashOfVariants.DeleteVariantReference(Data: Pointer);
begin
  if Data <> nil then
    Dispose(PVariant(Data));
end;

function TLXStringHashOfVariants.Add(const Key: string;
  const Data: Variant): PLXStringHashItem;
begin
  Result := Add(Key);
  New(PVariant(Result^.Data));
  PVariant(Result^.Data)^ := Data;
end;

function TLXStringHashOfVariants.Put(const Key: string;
  const Data: Variant): PLXStringHashItem;
begin
  Result := Put(Key);
  New(PVariant(Result^.Data));
  PVariant(Result^.Data)^ := Data;
end;


end.